home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / bin / mtrace < prev    next >
Text File  |  2006-05-08  |  6KB  |  238 lines
  1. #! /usr/bin/perl
  2. eval "exec /usr/bin/perl -S $0 $*"
  3.     if 0;
  4. # Copyright (C) 1997-2002, 2003, 2004 Free Software Foundation, Inc.
  5. # This file is part of the GNU C Library.
  6. # Contributed by Ulrich Drepper <drepper@gnu.org>, 1997.
  7. # Based on the mtrace.awk script.
  8.  
  9. # The GNU C Library is free software; you can redistribute it and/or
  10. # modify it under the terms of the GNU Lesser General Public
  11. # License as published by the Free Software Foundation; either
  12. # version 2.1 of the License, or (at your option) any later version.
  13.  
  14. # The GNU C Library is distributed in the hope that it will be useful,
  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. # Lesser General Public License for more details.
  18.  
  19. # You should have received a copy of the GNU Lesser General Public
  20. # License along with the GNU C Library; if not, write to the Free
  21. # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  22. # 02111-1307 USA.
  23.  
  24. $VERSION = "2.3.6";
  25. $PACKAGE = "libc";
  26. $progname = $0;
  27.  
  28. sub usage {
  29.     print "Usage: mtrace [OPTION]... [Binary] MtraceData\n";
  30.     print "  --help       print this help, then exit\n";
  31.     print "  --version    print version number, then exit\n";
  32.     print "\n";
  33.     print "For bug reporting instructions, please see:\n";
  34.     print "<http://www.gnu.org/software/libc/bugs.html>.\n";
  35.     exit 0;
  36. }
  37.  
  38. # We expect two arguments:
  39. #   #1: the complete path to the binary
  40. #   #2: the mtrace data filename
  41. # The usual options are also recognized.
  42.  
  43. arglist: while (@ARGV) {
  44.     if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver" ||
  45.     $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi" ||
  46.     $ARGV[0] eq "--versio" || $ARGV[0] eq "--version") {
  47.     print "mtrace (GNU $PACKAGE) $VERSION\n";
  48.     print "Copyright (C) 2005 Free Software Foundation, Inc.\n";
  49.     print "This is free software; see the source for copying conditions.  There is NO\n";
  50.     print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
  51.     print "Written by Ulrich Drepper <drepper\@gnu.org>\n";
  52.  
  53.     exit 0;
  54.     } elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel" ||
  55.          $ARGV[0] eq "--help") {
  56.     &usage;
  57.     } elsif ($ARGV[0] =~ /^-/) {
  58.     print "$progname: unrecognized option `$ARGV[0]'\n";
  59.     print "Try `$progname --help' for more information.\n";
  60.     exit 1;
  61.     } else {
  62.     last arglist;
  63.     }
  64. }
  65.  
  66. if ($#ARGV == 0) {
  67.     $binary="";
  68.     $data=$ARGV[0];
  69. } elsif ($#ARGV == 1) {
  70.     $binary=$ARGV[0];
  71.     $data=$ARGV[1];
  72.  
  73.     if ($binary =~ /^.*[\/].*$/) {
  74.     $prog = $binary;
  75.     } else {
  76.     $prog = "./$binary";
  77.     }
  78.     if (open (LOCS, "env LD_TRACE_LOADED_OBJECTS=1 $prog |")) {
  79.     while (<LOCS>) {
  80.         chop;
  81.         if (/^.*=> (.*) .(0x[0123456789abcdef]*).$/) {
  82.         $locs{$1} = $2;
  83.         }
  84.     }
  85.     close (LOCS);
  86.     }
  87. } else {
  88.     die "Wrong number of arguments, run $progname --help for help.";
  89. }
  90.  
  91. sub location {
  92.     my $str = pop(@_);
  93.     return $str if ($str eq "");
  94.     if ($str =~ /.*[[](0x[^]]*)]:(.)*/) {
  95.     my $addr = $1;
  96.     my $fct = $2;
  97.     return $cache{$addr} if (exists $cache{$addr});
  98.     if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
  99.         my $line = <ADDR>;
  100.         chomp $line;
  101.         close (ADDR);
  102.         if ($line ne '??:0') {
  103.         $cache{$addr} = $line;
  104.         return $cache{$addr};
  105.         }
  106.     }
  107.     $cache{$addr} = $str = "$fct @ $addr";
  108.     } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) {
  109.     my $prog = $1;
  110.     my $addr = $2;
  111.     my $searchaddr;
  112.     return $cache{$addr} if (exists $cache{$addr});
  113.     if ($locs{$prog} ne "") {
  114.         $searchaddr = sprintf "%#x", $addr - $locs{$prog};
  115.     } else {
  116.         $searchaddr = $addr;
  117.         $prog = $binary;
  118.     }
  119.     if ($binary ne "" && open (ADDR, "addr2line -e $prog $searchaddr|")) {
  120.         my $line = <ADDR>;
  121.         chomp $line;
  122.         close (ADDR);
  123.         if ($line ne '??:0') {
  124.         $cache{$addr} = $line;
  125.         return $cache{$addr};
  126.         }
  127.     }
  128.     $cache{$addr} = $str = $addr;
  129.     } elsif ($str =~ /^.*[[](0x[^]]*)]$/) {
  130.     my $addr = $1;
  131.     return $cache{$addr} if (exists $cache{$addr});
  132.     if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
  133.         my $line = <ADDR>;
  134.         chomp $line;
  135.         close (ADDR);
  136.         if ($line ne '??:0') {
  137.         $cache{$addr} = $line;
  138.         return $cache{$addr};
  139.         }
  140.     }
  141.     $cache{$addr} = $str = $addr;
  142.     }
  143.     return $str;
  144. }
  145.  
  146. $nr=0;
  147. open(DATA, "<$data") || die "Cannot open mtrace data file";
  148. while (<DATA>) {
  149.     my @cols = split (' ');
  150.     my $n, $where;
  151.     if ($cols[0] eq "@") {
  152.     # We have address and/or function name.
  153.     $where=$cols[1];
  154.     $n=2;
  155.     } else {
  156.     $where="";
  157.     $n=0;
  158.     }
  159.  
  160.     $allocaddr=$cols[$n + 1];
  161.     $howmuch=hex($cols[$n + 2]);
  162.  
  163.     ++$nr;
  164.     SWITCH: {
  165.     if ($cols[$n] eq "+") {
  166.         if (defined $allocated{$allocaddr}) {
  167.         printf ("+ %#010x Alloc %d duplicate: %s %s\n",
  168.             hex($allocaddr), $nr, &location($addrwas{$allocaddr}),
  169.             $where);
  170.         } else {
  171.         $allocated{$allocaddr}=$howmuch;
  172.         $addrwas{$allocaddr}=$where;
  173.         }
  174.         last SWITCH;
  175.     }
  176.     if ($cols[$n] eq "-") {
  177.         if (defined $allocated{$allocaddr}) {
  178.         undef $allocated{$allocaddr};
  179.         undef $addrwas{$allocaddr};
  180.         } else {
  181.         printf ("- %#010x Free %d was never alloc'd %s\n",
  182.             hex($allocaddr), $nr, &location($where));
  183.         }
  184.         last SWITCH;
  185.     }
  186.     if ($cols[$n] eq "<") {
  187.         if (defined $allocated{$allocaddr}) {
  188.         undef $allocated{$allocaddr};
  189.         undef $addrwas{$allocaddr};
  190.         } else {
  191.         printf ("- %#010x Realloc %d was never alloc'd %s\n",
  192.             hex($allocaddr), $nr, &location($where));
  193.         }
  194.         last SWITCH;
  195.     }
  196.     if ($cols[$n] eq ">") {
  197.         if (defined $allocated{$allocaddr}) {
  198.         printf ("+ %#010x Realloc %d duplicate: %#010x %s %s\n",
  199.             hex($allocaddr), $nr, $allocated{$allocaddr},
  200.             &location($addrwas{$allocaddr}), &location($where));
  201.         } else {
  202.         $allocated{$allocaddr}=$howmuch;
  203.         $addrwas{$allocaddr}=$where;
  204.         }
  205.         last SWITCH;
  206.     }
  207.     if ($cols[$n] eq "=") {
  208.         # Ignore "= Start".
  209.         last SWITCH;
  210.     }
  211.     if ($cols[$n] eq "!") {
  212.         # Ignore failed realloc for now.
  213.         last SWITCH;
  214.     }
  215.     }
  216. }
  217. close (DATA);
  218.  
  219. # Now print all remaining entries.
  220. @addrs= keys %allocated;
  221. $anything=0;
  222. if ($#addrs >= 0) {
  223.     foreach $addr (sort @addrs) {
  224.     if (defined $allocated{$addr}) {
  225.         if ($anything == 0) {
  226.         print "\nMemory not freed:\n-----------------\n";
  227.         print ' ' x (10 - 7), "Address     Size     Caller\n";
  228.         $anything=1;
  229.         }
  230.         printf ("%#010x %#8x  at %s\n", hex($addr), $allocated{$addr},
  231.             &location($addrwas{$addr}));
  232.     }
  233.     }
  234. }
  235. print "No memory leaks.\n" if ($anything == 0);
  236.  
  237. exit $anything != 0;
  238.